home *** CD-ROM | disk | FTP | other *** search
/ CD Fun House 1 / CD Fun House (Wayzata Technology).iso / •Word Games• / WordFind ••• / Source / sort.p < prev    next >
Text File  |  1987-11-14  |  2KB  |  114 lines
  1. UNIT sorts;
  2. INTERFACE
  3.     USES
  4.         stringf;
  5.     CONST
  6.         MAXWORDS = 50;
  7.     TYPE
  8.         wordlist = ARRAY[1..50] OF STRING;
  9.     VAR
  10.         ourlist : wordlist;
  11.  
  12.     PROCEDURE ssort1 (n : integer); {by size}
  13.     PROCEDURE ssort2 (n : integer); {by alpha}
  14.  
  15. IMPLEMENTATION
  16.     FUNCTION comp1 (i, j : integer) : integer;(* compares length*)
  17. {returns -1 if i > j; 1 if j > i ; and 0 if i = j}
  18.     BEGIN
  19.         IF length(ourlist[i]) > length(ourlist[j]) THEN
  20.             comp1 := -1
  21.         ELSE IF length(ourlist[i]) < length(ourlist[j]) THEN
  22.             comp1 := 1
  23.         ELSE
  24.             comp1 := 0;
  25.     END;
  26.     FUNCTION comp2 (i, j : integer) : integer;
  27.     BEGIN
  28.         IF strcmp(ourlist[i], ourlist[j]) > 0 THEN
  29.             comp2 := 1
  30.         ELSE IF strcmp(ourlist[i], ourlist[j]) < 0 THEN
  31.             comp2 := -1
  32.         ELSE
  33.             comp2 := 0;
  34.     END;
  35.  
  36.     PROCEDURE swap (i, j : integer);
  37.         VAR
  38.             s : STRING;
  39.     BEGIN
  40.         s := ourlist[i];
  41.         ourlist[i] := ourlist[j];
  42.         ourlist[j] := s;
  43.     END;
  44.  
  45.  
  46. {This sort is a port from the C programmer's library by}
  47. {Purdum, Leslie and Stegmoller}
  48.     PROCEDURE ssort1;
  49.         LABEL
  50.             100;
  51.         VAR
  52.             h, i, j, k, m : integer;
  53.     BEGIN
  54.         m := n;
  55.         WHILE (m DIV 2) > 0 DO
  56.             BEGIN
  57.                 m := m DIV 2;
  58.                 k := n - m;
  59.                 j := 1;
  60.                 REPEAT
  61.                     BEGIN
  62.                         i := j;
  63.                         REPEAT
  64.                             BEGIN
  65.                                 h := i + m;
  66.                                 IF comp1(i, h) > 0 THEN
  67.                                     BEGIN
  68.                                         swap(i, h);
  69.                                         i := i - m;
  70.                                     END
  71.                                 ELSE
  72.                                     GOTO 100;
  73.                             END;
  74.                         UNTIL i < 1;
  75. 100 :
  76.                         j := j + 1;
  77.                     END;
  78.                 UNTIL j > k;
  79.             END;
  80.     END;
  81.     PROCEDURE ssort2;
  82.         LABEL
  83.             100;
  84.         VAR
  85.             h, i, j, k, m : integer;
  86.     BEGIN
  87.         m := n;
  88.         WHILE (m DIV 2) > 0 DO
  89.             BEGIN
  90.                 m := m DIV 2;
  91.                 k := n - m;
  92.                 j := 1;
  93.                 REPEAT
  94.                     BEGIN
  95.                         i := j;
  96.                         REPEAT
  97.                             BEGIN
  98.                                 h := i + m;
  99.                                 IF comp2(i, h) > 0 THEN
  100.                                     BEGIN
  101.                                         swap(i, h);
  102.                                         i := i - m;
  103.                                     END
  104.                                 ELSE
  105.                                     GOTO 100;
  106.                             END;
  107.                         UNTIL i < 1;
  108. 100 :
  109.                         j := j + 1;
  110.                     END;
  111.                 UNTIL j > k;
  112.             END;
  113.     END;
  114. END.